Turnbull China Bikeride/Turnbull China Bikeride - Disc 2.iso/BARNET/COMPILER/SATHER/!Sather/Library/Containrs/sa/hashtab

Text File | 1996-07-16 | 12KB | 429 lines

---------------------------> Sather 1.1 source file <--------------------------
-- $Id: hashtab.sa,v 1.7 1996/07/16 04:38:14 holger Exp $
-- Author: Holger Klawitter <[e-mail]>
--
-- hashtab.sa:
-- DYNAMIC_BUCKET_TABLE{K,BUCKET}
-- DYNAMIC_DATABUCKET_TABLE{K,BUCKET}
--   The dynamic hash table used as basis for container classes
--   H_SET, H_MAP, H_BAG and H_MULTIMAP.
--   Unlike normal hash tables a dynamic hash table can do fast shrinking.
--   See: Per-Ake Larson; Communications of the ACM Vol.31 (1988) P.446-457
-- BUCKET{E}
-- DATABUCKET{K,E}
--   Implementation of the cell contents of the dynamic hashs table. BUCKETs
--   are not used in the interface of the hash table.
-- $BUCKET{E,ME}
--   Type bound for buckets in a dynamic hash table.
---------------------------------------------------------------------------
class DYNAMIC_BUCKET_TABLE{E,BUCKET<$BUCKET{E,BUCKET}} is
   -- Data structure used to implement a hash table.
   -- Per-Ake Larson; Communications of the ACM Vol.31 (1988) P.446-457
   -- The directory/segment structure is changed in favor of a dymnamically
   -- changing array as storage area.
    include COMPARE{E} elt_eq->elt_key_eq,elt_hash->elt_key_hash,
      elt_nil->elt_key_nil,elt_lt->,is_elt_nil->;

    private shared lower_fill_ratio: FLT := 0.800;
    private shared upper_fill_ratio: FLT := 1.000;
    -- For fast access one needs a low ratio between number of elements in the
    -- and number of cells. For efficient memory usage one needs a high ratio.
    -- The ratio should always be between these two bounds (unless the table
    -- is really small; where the ratio can get even lower.)

    private attr store: AREF{BUCKET};
    -- Here is the data being stored.

    private attr doubles: INT;
    -- Number of times the initial table size has been doubled.

    private attr split_pos: INT;
    -- Position of the next bucket to split.

    private attr bound: INT;
    -- Upper bound for split_pos. Is always initial_size * 2.pow(doubles)

    private attr asize: INT;
    -- The size of the fraction of the store which is currently in use.
    -- Array access beyond this bound is illegal.

    private attr minsize: INT;
    -- Lower bound for the store size.

    readonly attr n_inds: INT;
    -- Returns the number of elements (resp. indices) in the table.

    private hash(e:E): INT  pre ~void(self) is
    -- Returns the bucket to store e. This number will be
    -- generated from the hash-value and be normailzed through
    -- the actual size of the set.
    h,res: INT;

    h := elt_key_hash(e);
    res := h % bound;
    if res >= split_pos then return res end;
    return h % ( bound.lshift(1) )
    end;

    set_bucket(i:INT,l:BUCKET)
      pre 0 <= i and i < asize and ~void(self)
    is
    store[i]:=l
    end;

    bucket(i:INT): BUCKET
      pre 0 <= i and i < asize and ~void(self)
    is
    return store[i]
    end;

    create: SAME
    is
    if void(self) then return create_sized(16) end;
    return create_sized(minsize.rshift(1))
    end;

    create_sized(initial_size:INT): SAME
    -- Creating a table with another minimal size. This might be useful to avoid
    -- shrinking of large table which might get very empty.
      pre initial_size.is_even and initial_size > 0
    is
    res ::= new;
    res.store := #AREF{BUCKET}(initial_size.lshift(2));
    res.bound := initial_size;
    res.asize := initial_size.lshift(1);
    res.minsize := initial_size.lshift(1);
    return res
    end;

   map_copy: SAME    pre ~void(self) is
      -- Returns a copy of self with all properties set like self.
      res ::= new;
      res.store := store.create(store.asize);
      res.asize := asize;
      res.n_inds := n_inds;
      res.minsize := minsize;
      res.bound := bound;
      res.doubles := doubles;
      res.split_pos := split_pos;
      loop
     i ::= 0.upto!(asize-1);
     res.store[i] := store[i].copy_list;
      end;
      return res
   end;

    -- The functions changing the size of the bucket table:
    -- They are split into three steps.
    -- 1.) Splitting the next bucket into two (update_*)
    -- 2.) Resizing the storage area. (shrink/grow)
    -- 3.) Using the next storage cell for the new bucket. (update_*)

    private grow pre ~void(self) is
    -- Increases the size of the array by one.
    -- The functions changing the size of the bucket table:
    -- They are split into two parts.
    -- 1.) Splitting the next bucket into two. (update_*)
    -- 2.) Resizing the storage area. (shrink/grow)
    if store.asize = asize then
        news ::= store.create(asize.lshift(1));
        loop news.aset!(store.aelt!) end;
        store := news
    end;
    asize := asize + 1;
    end;

   private shrink  pre ~void(self) is
    -- Decreases the size of the array by one.
    -- Resizes the storage area, if neccessary.
    if asize = minsize then return end;
    if store.asize = asize.lshift(1) then
        news ::= store.create(asize);
        loop news.aset!(store.aelt!) end;
        store := news
    end;
    asize := asize - 1;
    end;

    private update_insert is
    -- Checks the actual fill ratio of the set.
    -- Adds a bucket to the hash table if the ratio is high enough.
    -- The functions changing the size of the bucket table
    -- are split into two parts.
    -- 1.) Splitting the next bucket into two. (update_*)
    -- 2.) Resizing the storage area. (shrink/grow)
    if n_inds.flt / (bound+split_pos).flt < upper_fill_ratio then
        return
    end;

    cur ::= bucket(split_pos);
    prev ::= cur; prev := void;
    -- This is an ugly hack to make prev to have the same type
    -- like cur.
    loop until!( void(cur) );
        if elt_key_hash(cur.item) % ( bound.lshift(1) ) = split_pos
        then -- keep in the old bucket
        prev := cur;
        cur := cur.next;
        else -- put into new bucket
        if void(prev) then -- the first one for new bucket
            set_bucket(split_pos, cur.next);
            cur.next( bucket(bound + split_pos) );
            set_bucket( bound + split_pos, cur );
            cur := bucket( split_pos )
        else
            prev.next(cur.next);
            cur.next( bucket( bound + split_pos ));
            set_bucket( bound + split_pos, cur );
            cur := prev.next
        end
        end
    end;
    grow;
    split_pos := split_pos + 1;
    if split_pos = bound then
        split_pos := 0;
        doubles := doubles + 1;
        bound := bound.lshift(1);
    end
    end; -- update_insert

    private update_delete is
    -- Checks the actual fill ratio of the set.
    -- Removes a bucket from the hash table if the ratio is low enough.
    if n_inds.flt / (bound+split_pos).flt > lower_fill_ratio then
        return
    end;

    --      to_merge ::= bucket(split_pos);
    --      if void(to_merge) then -- just get the other bucket
    --     set_bucket( split_pos, bucket( bound + split_pos ))
    --      else
    --     to_merge.append( bucket( bound + split_pos ) )
    --      end;
    --      set_bucket( bound + split_pos, void );
    --      shrink;
    split_pos := split_pos - 1;
    if split_pos < 0 then
        if doubles = 0 then
        split_pos := 0
        else
        doubles := doubles - 1;
        bound := bound.rshift(1);
        split_pos := bound - 1;
        end
    end;
    shrink;
    to_merge ::= bucket(split_pos);
    if void(to_merge) then -- just get the other bucket
        set_bucket( split_pos, bucket( bound + split_pos ))
    else
        to_merge.append( bucket( bound + split_pos ) )
    end;
    set_bucket( bound + split_pos, void );
    end; -- update_delete

    dbg: STR
    -- Returns an interal string representation of the hashtable.
    -- For debugging only.
    is
    res:STR;
    res := "split_pos=" + split_pos + ", bound=" + bound +
          ", asize=" + asize + ", size=" + n_inds + ", minsize=" +
          minsize + "\n";
    loop
        l ::= store.aelt!;
        bkt: STR := "";
        itemstr: STR;
        item ::= l.list!.item;
        typecase item
        when $STR then itemstr := item.str
        else itemstr := SYS::id(item).str; end;
        loop bkt := bkt + ",".separate!(itemstr) end;
        res := res + ", ".separate!(0.up!.str+"="+bkt);
    end;
    return res+"\n";
    end; -- dbg

end; -- DYNAMIC_BUCKET_TABLE
---------------------------------------------------------------------------
class DYNAMIC_DATABUCKET_TABLE{K,E}
-- This version of a DYNAMIC_BUCKET_TABLE does not simply store elements,
-- it stores datas and keys seperately in each bucket, instead.
-- Used in H_BAG, H_MAP and H_MULTIMAP.
is
    include DYNAMIC_BUCKET_TABLE{K,DATABUCKET{K,E}};

    private data_nil: E is
    e: E;
    typecase e
    when $NIL then
        temp::= e.nil; typecase temp when E then return temp end;
    else return void   end
    end;

    map_aset(k:K,e:E) pre ~void(self) is
    -- Over-ride data if 'k' exists.
    -- Otherwise grow the bucket chain associated with hash(k)
    h ::= hash(k);
    loop
        b ::= bucket(h).list!;
        if elt_key_eq(b.item,k) then b.data := e; return end
    end;
    set_bucket( h, #DATABUCKET{K,E}(k,e,bucket(h)) );
    n_inds := n_inds + 1;
    update_insert
    end;

    map_delete(k:K): E  pre ~void(self) is
    -- Removes an element from the set.
    -- Does nothing if there is no such element.
    h ::= hash(k);
    b ::= bucket(h);
    prev ::= b; prev := void; -- NASTY HACK to force type inference on prev.

    loop until!( void(b) or elt_key_eq(b.item,k) );
        prev := b;
        b := b.next
    end;
    if void(b) then
        return data_nil
    end;
    res ::= b.data;
    if void(prev) then  set_bucket( h, b.next )
    else prev.next(b.next)   end;
    n_inds := n_inds - 1;
    update_delete;
    return res
    end; -- map_delete

    map_has_ind(k:K): BOOL  pre ~void(self) is
    loop
        if elt_key_eq(bucket(hash(k)).list!.item,k) then  return true end
    end;
    return false
    end;

    map_aget(k:K): E  pre ~void(self) is
    -- Returns the element equal to 'e' from the set.
    -- Returns void or T::nil if there is no such element.
    -- Self may not be void.
    loop
        b ::= bucket(hash(k)).list!;
        if elt_key_eq(b.item,k) then return b.data end
    end;
    return data_nil
    end;

    map_key!: K
      pre ~void(self)
    is
    loop
        b ::= bucket( 0.upto!(bound+split_pos-1) );
        loop yield b.list!.item end
    end
    end;

    map_elt!: E  pre ~void(self) is
    loop
        b ::= bucket( 0.upto!(bound+split_pos-1) );
        loop yield b.list!.data end
    end
    end;

    map_pair!: TUP{K,E} pre ~void(self) is
    loop
        b ::= bucket( 0.upto!(bound+split_pos-1) );
        loop
        bk ::= b.list!;
        yield #TUP{K,E}(bk.item,bk.data)
        end
    end
    end;

end; -- DYNAMIC_DATABUCKET_TABLE
---------------------------------------------------------------------------
abstract class $BUCKET{E,ME<$BUCKET{E,ME}} < $NEXT{ME}
is
    item: E;
    copy_list: SAME;
    list!: SAME;
end; -- $BUCKET{E,SELF}
---------------------------------------------------------------------------
class BUCKET{E} < $BUCKET{E,BUCKET{E}}  is
   -- Mainly this class adds an item to NEXT and gives some handy constructors.
   include NEXT{SAME};

   attr item: E;

   create(e:E): SAME is
      -- Create a link containing e.
      res ::= new;
      res.item := e;
      return res
   end;

   create(e:E,n:SAME): SAME is
      -- Create a link containig e and prepending the link n.
      -- n may be void.
      res ::= new;
      res.item := e; res.next := n;
      return res
   end;

   copy_list: SAME is
      -- Returns a copy of self and all following links. The
      -- objects will not be 'copy'ed.
      -- Self may be void.
      if void(self) then return void end;
      return #SAME(item,next.copy_list)
   end;

   list!: SAME is
      -- Yields all subsequent elements in the list.
      b ::= self;
      loop until!( void(b) ); yield b; b := b.next end
   end;

end;
---------------------------------------------------------------------------
class DATABUCKET{K,E} < $BUCKET{K,DATABUCKET{K,E}} is
   -- An addition to BUCKET{K} this class also adds data.

   include NEXT{SAME};

   attr item: K;
   attr data: E;

   create(k:K): SAME is
      res ::= new;
      res.item := k;
      return res
   end;

   create(k:K,e:E): SAME is
      res ::= new;
      res.item := k; res.data := e;
      return res
   end;

   create(k:K,e:E,n:SAME): SAME is
      res ::= new;
      res.item := k; res.data := e; res.next := n;
      return res
   end;

   copy_list: SAME  is
      if void(self) then return void end;
      return #SAME(item,data,next.copy_list)
   end;

   list!: SAME is
      -- Yields all subsequent elements in the list.
      b ::= self;
      loop until!( void(b) ); yield b; b := b.next end
   end;

end; -- DATABUCKET{K,E}
----------------------------------------------------------------------